*DECK DDQCK
      SUBROUTINE DDQCK (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  DDQCK
C***PURPOSE  Quick check for SLATEC routines DDRIV1, DDRIV2 and DDRIV3.
C***LIBRARY   SLATEC (SDRIVE)
C***CATEGORY  I1A2, I1A1B
C***TYPE      DOUBLE PRECISION (SDQCK-S, DDQCK-D, CDQCK-C)
C***KEYWORDS  DDRIV1, DDRIV2, DDRIV3, QUICK CHECK, SDRIVE
C***AUTHOR  Kahaner, D. K., (NIST)
C             National Institute of Standards and Technology
C             Gaithersburg, MD  20899
C           Sutherland, C. D., (LANL)
C             Mail Stop D466
C             Los Alamos National Laboratory
C             Los Alamos, NM  87545
C***DESCRIPTION
C
C  For assistance in determining the cause of a failure of these
C  routines contact C. D. Sutherland at commercial telephone number
C  (505)667-6949, FTS telephone number 8-843-6949, or electronic mail
C  address CDS@LANL.GOV .
C
C***ROUTINES CALLED  D1MACH, DDF, DDRIV1, DDRIV2, DDRIV3, XERCLR
C***REVISION HISTORY  (YYMMDD)
C   890405  DATE WRITTEN
C   890405  Revised to meet SLATEC standards.
C***END PROLOGUE  DDQCK
      EXTERNAL DDF
      DOUBLE PRECISION ALFA, EPS, EWT(1), HMAX, D1MACH, T, TOUT
      INTEGER IERFLG, IERROR, IMPL, IPASS, KPRINT, LENIW, LENIWX, LENW,
     8        LENWMX, LENWX, LIWMX, LUN, MINT, MITER, ML, MSTATE, MU,
     8        MXORD, MXSTEP, N, NDE, NFE, NJE, NROOT, NSTATE, NSTEP,
     8        NTASK, NX
      PARAMETER(ALFA = 1.D0, HMAX = 15.D0, IERROR = 3, IMPL = 0,
     8          LENWMX = 342, LIWMX = 53, MITER = 5, ML = 2, MU = 2,
     8          MXORD = 5, MXSTEP = 1000, N = 3, NROOT = 0, NTASK = 1)
      DOUBLE PRECISION WORK(LENWMX), Y(N+1)
      INTEGER IWORK(LIWMX)
      DATA EWT(1) /.00001D0/
C***FIRST EXECUTABLE STATEMENT  DDQCK
      EPS = D1MACH(4)**(1.D0/3.D0)
      IPASS = 1
C                                            Exercise DDRIV1 for problem
C                                            with known solution.
      Y(4) = ALFA
      T = 0.D0
      Y(1) = 10.D0
      Y(2) = 0.D0
      Y(3) = 10.D0
      TOUT = 10.D0
      MSTATE = 1
      LENW = 342
      CALL DDRIV1 (N, T, Y, DDF, TOUT, MSTATE, EPS, WORK, LENW, IERFLG)
      NSTEP = WORK(LENW - (N + 50) + 3)
      NFE = WORK(LENW - (N + 50) + 4)
      NJE = WORK(LENW - (N + 50) + 5)
      IF (MSTATE .EQ. 2) THEN
        IF (ABS(1.D0 - Y(1)*1.5D0) .LE. EPS**(2.D0/3.D0) .AND.
     8  ABS(1.D0 - Y(2)*3.D0) .LE. EPS**(2.D0/3.D0) .AND.
     8  ABS(1.D0 - Y(3)) .LE. EPS**(2.D0/3.D0)) THEN
          IF (KPRINT .EQ. 2) THEN
            WRITE(LUN, '('' DDRIV1:The solution determined met '',
     8      ''the expected values.'' //)')
          ELSE IF (KPRINT .EQ. 3) THEN
            WRITE(LUN, '('' DDRIV1:The solution determined met '',
     8      ''the expected values.'')')
            WRITE(LUN, '('' The values of results are '')')
            WRITE(LUN, *) ' T ', T
            WRITE(LUN, *) ' Y(1) ', Y(1)
            WRITE(LUN, *) ' Y(2) ', Y(2)
            WRITE(LUN, *) ' Y(3) ', Y(3)
            WRITE(LUN, '(/)')
          END IF
        ELSE
          IF (KPRINT .EQ. 1) THEN
            WRITE(LUN, '('' DDRIV1:The solution determined is not '',
     8      ''accurate enough.'' //)')
          ELSE IF (KPRINT .EQ. 2) THEN
            WRITE(LUN, '('' DDRIV1:The solution determined is not '',
     8      ''accurate enough.'')')
            WRITE(LUN, '('' The values of parameters, results, and '',
     8      ''statistical quantities are:'')')
            WRITE(LUN, *) ' EPS = ', EPS
            WRITE(LUN, *) ' T ', T
            WRITE(LUN, *) ' Y(1) ', Y(1)
            WRITE(LUN, *) ' Y(2) ', Y(2)
            WRITE(LUN, *) ' Y(3) ', Y(3)
            WRITE(LUN, *)
     8      ' Number of steps taken is  ', NSTEP
            WRITE(LUN, *)
     8      ' Number of evaluations of the right hand side is  ', NFE
            WRITE(LUN, *)
     8      ' Number of evaluations of the Jacobian matrix is  ', NJE
            WRITE(LUN, '(//)')
          END IF
          IPASS = 0
        END IF
      ELSE
        IF (KPRINT .EQ. 1) THEN
          WRITE(LUN, '('' While using DDRIV1, a solution was not '',
     8    ''obtained.'' //)')
        ELSE IF (KPRINT .GE. 2) THEN
          WRITE(LUN, '('' While using DDRIV1, a solution was not '',
     8    ''obtained.'')')
          WRITE(LUN, '('' The values of parameters, results, and '',
     8    ''statistical quantities are:'')')
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, *) ' N ', N, ', EPS ', EPS, ', LENW ', LENW
          WRITE(LUN, *) ' T ', T
          WRITE(LUN, *) ' Y(1) ', Y(1)
          WRITE(LUN, *) ' Y(2) ', Y(2)
          WRITE(LUN, *) ' Y(3) ', Y(3)
          WRITE(LUN, *)
     8    ' Number of steps taken is  ', NSTEP
          WRITE(LUN, *)
     8    ' Number of evaluations of the right hand side is  ', NFE
          WRITE(LUN, *)
     8    ' Number of evaluations of the Jacobian matrix is  ', NJE
          WRITE(LUN, '(//)')
        END IF
        IPASS = 0
      END IF
      CALL XERCLR
C                                         Run DDRIV1 with invalid input.
      NX = 201
      T = 0.D0
      Y(1) = 10.D0
      Y(2) = 0.D0
      Y(3) = 10.D0
      Y(4) = ALFA
      TOUT = 10.D0
      MSTATE = 1
      LENW = 342
      CALL DDRIV1 (NX, T, Y, DDF, TOUT, MSTATE, EPS, WORK, LENW, IERFLG)
      IF (IERFLG .EQ. 21) THEN
        IF (KPRINT .EQ. 2) THEN
          WRITE(LUN, '('' DDRIV1:An invalid parameter has been '',
     8    ''correctly detected.'' //)')
        ELSE IF (KPRINT .EQ. 3) THEN
          WRITE(LUN, '('' DDRIV1:An invalid parameter has been '',
     8    ''correctly detected.'')')
          WRITE(LUN, *) ' The value of N was set to ', NX
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '(/)')
        END IF
      ELSE
        IF (KPRINT .EQ. 1) THEN
          WRITE(LUN, '('' DDRIV1:An invalid parameter has not '',
     8    ''been correctly detected.'' //)')
        ELSE IF (KPRINT .GE. 2) THEN
          WRITE(LUN, '('' DDRIV1:An invalid parameter has not '',
     8    ''been correctly detected.'')')
          WRITE(LUN, *) ' The value of N was set to ', NX
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '('' The values of parameters, results, and '',
     8    ''statistical quantities are:'')')
          WRITE(LUN, *) ' EPS ', EPS, ', LENW ', LENW
          WRITE(LUN, *) ' T ', T
          WRITE(LUN, *) ' Y(1) ', Y(1)
          WRITE(LUN, *) ' Y(2) ', Y(2)
          WRITE(LUN, *) ' Y(3) ', Y(3)
          WRITE(LUN, *)
     8    ' Number of steps taken is  ', NSTEP
          WRITE(LUN, *)
     8    ' Number of evaluations of the right hand side is  ', NFE
          WRITE(LUN, *)
     8    ' Number of evaluations of the Jacobian matrix is  ', NJE
          WRITE(LUN, '(//)')
        END IF
        IPASS = 0
      END IF
      CALL XERCLR
C                                            Exercise DDRIV2 for problem
C                                            with known solution.
      T = 0.D0
      Y(1) = 10.D0
      Y(2) = 0.D0
      Y(3) = 10.D0
      Y(4) = ALFA
      MSTATE = 1
      TOUT = 10.D0
      MINT = 1
      LENW = 298
      LENIW = 50
      CALL DDRIV2 (N, T, Y, DDF, TOUT, MSTATE, NROOT, EPS, EWT,
     8             MINT, WORK, LENW, IWORK, LENIW, DDF, IERFLG)
      NSTEP = IWORK(3)
      NFE = IWORK(4)
      NJE = IWORK(5)
      IF (MSTATE .EQ. 2) THEN
        IF (ABS(1.D0 - Y(1)*1.5D0) .LE. EPS**(2.D0/3.D0) .AND.
     8  ABS(1.D0 - Y(2)*3.D0) .LE. EPS**(2.D0/3.D0) .AND.
     8  ABS(1.D0 - Y(3)) .LE. EPS**(2.D0/3.D0)) THEN
          IF (KPRINT .EQ. 2) THEN
            WRITE(LUN, '('' DDRIV2:The solution determined met '',
     8      ''the expected values.'' //)')
          ELSE IF (KPRINT .EQ. 3) THEN
            WRITE(LUN, '('' DDRIV2:The solution determined met '',
     8      ''the expected values.'')')
            WRITE(LUN, '('' The values of results are '')')
            WRITE(LUN, *) ' T ', T
            WRITE(LUN, *) ' Y(1) ', Y(1)
            WRITE(LUN, *) ' Y(2) ', Y(2)
            WRITE(LUN, *) ' Y(3) ', Y(3)
            WRITE(LUN, '(/)')
          END IF
        ELSE
          IF (KPRINT .EQ. 1) THEN
            WRITE(LUN, '('' DDRIV2:The solution determined is not '',
     8      ''accurate enough.'' //)')
          ELSE IF (KPRINT .EQ. 2) THEN
            WRITE(LUN, '('' DDRIV2:The solution determined is not '',
     8      ''accurate enough.'')')
            WRITE(LUN, '('' The values of parameters, results, and '',
     8      ''statistical quantities are:'')')
            WRITE(LUN, *) ' EPS = ', EPS, ', EWT = ', EWT
            WRITE(LUN, *) ' T ', T
            WRITE(LUN, *) ' Y(1) ', Y(1)
            WRITE(LUN, *) ' Y(2) ', Y(2)
            WRITE(LUN, *) ' Y(3) ', Y(3)
            WRITE(LUN, *)
     8      ' Number of steps taken is  ', NSTEP
            WRITE(LUN, *)
     8      ' Number of evaluations of the right hand side is  ', NFE
            WRITE(LUN, *)
     8      ' Number of evaluations of the Jacobian matrix is  ', NJE
            WRITE(LUN, '(//)')
          END IF
          IPASS = 0
        END IF
      ELSE
        IF (KPRINT .EQ. 1) THEN
          WRITE(LUN, '('' While using DDRIV2, a solution was not '',
     8    ''obtained.'' //)')
        ELSE IF (KPRINT .GE. 2) THEN
          WRITE(LUN, '('' While using DDRIV2, a solution was not '',
     8    ''obtained.'')')
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '('' The values of parameters, results, and '',
     8    ''statistical quantities are:'')')
          WRITE(LUN, *) ' EPS = ', EPS, ', EWT ', EWT
          WRITE(LUN, *)
     8    ' MINT = ', MINT, ', LENW ', LENW, ', LENIW ', LENIW
          WRITE(LUN, *) ' T ', T
          WRITE(LUN, *) ' Y(1) ', Y(1)
          WRITE(LUN, *) ' Y(2) ', Y(2)
          WRITE(LUN, *) ' Y(3) ', Y(3)
          WRITE(LUN, *)
     8    ' Number of steps taken is  ', NSTEP
          WRITE(LUN, *)
     8    ' Number of evaluations of the right hand side is  ', NFE
          WRITE(LUN, *)
     8    ' Number of evaluations of the Jacobian matrix is  ', NJE
          WRITE(LUN, '(//)')
        END IF
        IPASS = 0
      END IF
      CALL XERCLR
C                                         Run DDRIV2 with invalid input.
      T = 0.D0
      Y(1) = 10.D0
      Y(2) = 0.D0
      Y(3) = 10.D0
      Y(4) = ALFA
      TOUT = 10.D0
      MSTATE = 1
      MINT = 1
      LENWX = 1
      LENIW = 50
      CALL DDRIV2 (N, T, Y, DDF, TOUT, MSTATE, NROOT, EPS, EWT,
     8             MINT, WORK, LENWX, IWORK, LENIW, DDF, IERFLG)
      IF (IERFLG .EQ. 32) THEN
        IF (KPRINT .EQ. 2) THEN
          WRITE(LUN, '('' DDRIV2:An invalid parameter has been '',
     8    ''correctly detected.'' //)')
        ELSE IF (KPRINT .EQ. 3) THEN
          WRITE(LUN, '('' DDRIV2:An invalid parameter has been '',
     8    ''correctly detected.'')')
          WRITE(LUN, *)
     8    ' The value of LENW was set to ', LENWX
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '(/)')
        END IF
      ELSE
        IF (KPRINT .EQ. 1) THEN
          WRITE(LUN, '('' DDRIV2:An invalid parameter has not '',
     8    ''been correctly detected.'' //)')
        ELSE IF (KPRINT .GE. 2) THEN
          WRITE(LUN, '('' DDRIV2:An invalid parameter has not '',
     8    ''been correctly detected.'')')
          WRITE(LUN, *) ' The value of LENW was set to ', LENWX
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '('' The values of parameters, results, and '',
     8    ''statistical quantities are:'')')
          WRITE(LUN, *)
     8    ' EPS ', EPS, ', MINT ', MINT, ', LENW ', LENW,
     8    ', LENIW ', LENIW
          WRITE(LUN, *) ' T ', T
          WRITE(LUN, *) ' Y(1) ', Y(1)
          WRITE(LUN, *) ' Y(2) ', Y(2)
          WRITE(LUN, *) ' Y(3) ', Y(3)
          WRITE(LUN, *)
     8    ' Number of steps taken is  ', NSTEP
          WRITE(LUN, *)
     8    ' Number of evaluations of the right hand side is  ', NFE
          WRITE(LUN, *)
     8    ' Number of evaluations of the Jacobian matrix is  ', NJE
          WRITE(LUN, '(//)')
        END IF
        IPASS = 0
      END IF
      CALL XERCLR
C                                            Exercise DDRIV3 for problem
C                                            with known solution.
      T = 0.D0
      Y(1) = 10.D0
      Y(2) = 0.D0
      Y(3) = 10.D0
      Y(4) = ALFA
      NSTATE = 1
      TOUT = 10.D0
      MINT = 2
      LENW = 301
      LENIW = 53
      CALL DDRIV3 (N, T, Y, DDF, NSTATE, TOUT, NTASK, NROOT, EPS, EWT,
     8             IERROR, MINT, MITER, IMPL, ML, MU, MXORD, HMAX,
     8             WORK, LENW, IWORK, LENIW, DDF, DDF, NDE,
     8             MXSTEP, DDF, DDF, IERFLG)
      NSTEP = IWORK(3)
      NFE = IWORK(4)
      NJE = IWORK(5)
      IF (NSTATE .EQ. 2) THEN
        IF (ABS(1.D0 - Y(1)*1.5D0) .LE. EPS**(2.D0/3.D0) .AND.
     8  ABS(1.D0 - Y(2)*3.D0) .LE. EPS**(2.D0/3.D0) .AND.
     8  ABS(1.D0 - Y(3)) .LE. EPS**(2.D0/3.D0)) THEN
          IF (KPRINT .EQ. 2) THEN
            WRITE(LUN, '('' DDRIV3:The solution determined met '',
     8      ''the expected values.'' //)')
          ELSE IF (KPRINT .EQ. 3) THEN
            WRITE(LUN, '('' DDRIV3:The solution determined met '',
     8      ''the expected values.'')')
            WRITE(LUN, '('' The values of results are '')')
            WRITE(LUN, *) ' T ', T
            WRITE(LUN, *) ' Y(1) ', Y(1)
            WRITE(LUN, *) ' Y(2) ', Y(2)
            WRITE(LUN, *) ' Y(3) ', Y(3)
            WRITE(LUN, '(/)')
          END IF
        ELSE
          IF (KPRINT .EQ. 1) THEN
            WRITE(LUN, '('' DDRIV3:The solution determined is not '',
     8      ''accurate enough.'' //)')
          ELSE IF (KPRINT .GE. 2) THEN
            WRITE(LUN, '('' DDRIV3:The solution determined is not '',
     8      ''accurate enough.'')')
            WRITE(LUN, '('' The values of parameters, results, and '',
     8      ''statistical quantities are:'')')
            WRITE(LUN, *)
     8      ' EPS = ', EPS, ', EWT = ', EWT, ', IERROR = ', IERROR
            WRITE(LUN, *)
     8      ' MINT = ', MINT, ', MITER = ', MITER, ', IMPL = ', IMPL
            WRITE(LUN, *) ' T ', T
            WRITE(LUN, *) ' Y(1) ', Y(1)
            WRITE(LUN, *) ' Y(2) ', Y(2)
            WRITE(LUN, *) ' Y(3) ', Y(3)
            WRITE(LUN, *)
     8      ' Number of steps taken is  ', NSTEP
            WRITE(LUN, *)
     8      ' Number of evaluations of the right hand side is  ', NFE
            WRITE(LUN, *)
     8      ' Number of evaluations of the Jacobian matrix is  ', NJE
            WRITE(LUN, '(//)')
          END IF
          IPASS = 0
        END IF
      ELSE
        IF (KPRINT .EQ. 1) THEN
          WRITE(LUN, '('' While using DDRIV3, a solution was not '',
     8    ''obtained.'' //)')
        ELSE IF (KPRINT .GE. 2) THEN
          WRITE(LUN, '('' While using DDRIV3, a solution was not '',
     8    ''obtained.'')')
          WRITE(LUN, *)
     8    ' MSTATE = ', MSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '('' The values of parameters, results, and '',
     8    ''statistical quantities are:'')')
          WRITE(LUN, *)
     8    ' EPS = ', EPS, ', EWT = ', EWT, ', IERROR = ', IERROR
          WRITE(LUN, *)
     8    ' MINT = ', MINT, ', MITER = ', MITER, ', IMPL = ', IMPL
          WRITE(LUN, *) ' T ', T
          WRITE(LUN, *) ' Y(1) ', Y(1)
          WRITE(LUN, *) ' Y(2) ', Y(2)
          WRITE(LUN, *) ' Y(3) ', Y(3)
          WRITE(LUN, *)
     8    ' Number of steps taken is  ', NSTEP
          WRITE(LUN, *)
     8    ' Number of evaluations of the right hand side is  ', NFE
          WRITE(LUN, *)
     8    ' Number of evaluations of the Jacobian matrix is  ', NJE
          WRITE(LUN, '(//)')
        END IF
        IPASS = 0
      END IF
      CALL XERCLR
C                                         Run DDRIV3 with invalid input.
      T = 0.D0
      Y(1) = 10.D0
      Y(2) = 0.D0
      Y(3) = 10.D0
      Y(4) = ALFA
      NSTATE = 1
      TOUT = 10.D0
      MINT = 2
      LENW = 301
      LENIWX = 1
      CALL DDRIV3 (N, T, Y, DDF, NSTATE, TOUT, NTASK, NROOT, EPS,
     8             EWT, IERROR, MINT, MITER, IMPL, ML, MU,
     8             MXORD, HMAX, WORK, LENW, IWORK, LENIWX, DDF,
     8             DDF, NDE, MXSTEP, DDF, DDF, IERFLG)
      IF (IERFLG .EQ. 33) THEN
        IF (KPRINT .EQ. 2) THEN
          WRITE(LUN, '('' DDRIV3:An invalid parameter has been '',
     8    ''correctly detected.'' //)')
        ELSE IF (KPRINT .EQ. 3) THEN
          WRITE(LUN, '('' DDRIV3:An invalid parameter has been '',
     8    ''correctly detected.'')')
          WRITE(LUN, *)
     8    ' The value of LENIW was set to ', LENIWX
          WRITE(LUN, *)
     8    ' NSTATE = ', NSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '(/)')
        END IF
      ELSE
        IF (KPRINT .EQ. 1) THEN
          WRITE(LUN, '('' DDRIV3:An invalid parameter has not '',
     8    ''been correctly detected.'' //)')
        ELSE IF (KPRINT .GE. 2) THEN
          WRITE(LUN, '('' DDRIV3:An invalid parameter has not '',
     8    ''been correctly detected.'')')
          WRITE(LUN, *)
     8    ' The value of LENIW was set to ', LENIWX
          WRITE(LUN, *)
     8    ' NSTATE = ', NSTATE, ', Error number = ', IERFLG
          WRITE(LUN, '('' The values of parameters, results, and '',
     8    ''statistical quantities are:'')')
          WRITE(LUN, *)
     8    ' EPS = ', EPS, ', EWT = ', EWT, ', IERROR = ', IERROR
          WRITE(LUN, *)
     8    ' MINT = ', MINT, ', MITER = ', MITER, ', IMPL = ', IMPL
          WRITE(LUN, *) ' T ', T
          WRITE(LUN, *) ' Y(1) ', Y(1)
          WRITE(LUN, *) ' Y(2) ', Y(2)
          WRITE(LUN, *) ' Y(3) ', Y(3)
          WRITE(LUN, *)
     8    ' Number of steps taken is  ', NSTEP
          WRITE(LUN, *)
     8    ' Number of evaluations of the right hand side is  ', NFE
          WRITE(LUN, *)
     8    ' Number of evaluations of the Jacobian matrix is  ', NJE
          WRITE(LUN, '(//)')
        END IF
        IPASS = 0
      END IF
      CALL XERCLR
      RETURN
      END
